home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1999 May: Tool Chest / Developer CD Series Tool Chest (Apple Computer)(May 1999).iso / Tool Chest / Development Kits / MPW etc / MPW-GM / Interfaces&Libraries / Interfaces / AIncludes / ObjMacros.a < prev    next >
Encoding:
Text File  |  1996-05-07  |  12.3 KB  |  462 lines  |  [TEXT/MPS ]
  1. ;    File:        ObjMacros.a
  2. ;
  3. ;    Copyright:    © 1983-1996 by Apple Computer, Inc.
  4. ;                All rights reserved.
  5. ;___________________________________________________________________________
  6.  
  7.     IF &TYPE('__INCLUDINGOBJMACROS__') = 'UNDEFINED' THEN
  8. __INCLUDINGOBJMACROS__    SET    1
  9.  
  10.     IF &TYPE('__CONDITIONALMACROS__') = 'UNDEFINED' THEN
  11.     include 'ConditionalMacros.a'
  12.     ENDIF
  13.  
  14.     IF GENERATING68K THEN
  15.  
  16.                   IMPORT      %_METHOD
  17.                   IMPORT      %_OBNEW
  18.                   IF          &TYPE('ObjOptFlag') = 'UNDEFINED' THEN
  19. ObjOptFlag:       EQU         0
  20.                   ENDIF
  21.                   IF          &TYPE('DebugFlag') = 'UNDEFINED' THEN
  22. DebugFlag:        EQU         1
  23.                   ENDIF
  24.  
  25.  
  26.                   MACRO
  27.                   REFSELECTOR &ProcName,&ItsObjIndex,&OpCode
  28.  
  29.                   GBLA        &ObjSupers[250],&MethLists[250], &MethTable
  30.                   GBLC        &ObjNames[250]
  31.  
  32.                   LCLA        &start,&found,&objIndex,&LexInt
  33.  
  34.                   &found:     SETA 0
  35.                   IF          &FINDSYM(&MethTable,&ProcName) THEN
  36.                   &start:     SETA 1
  37.                   GOTO        .EndLoop
  38.                   WHILE       &SYSTOKEN <> 30 DO
  39.                   &LexInt:    SETA &S2I(&SYSTOKSTR)
  40.                   &objIndex:  SETA &ItsObjIndex
  41.                   WHILE       (&objIndex <> 0) DO
  42.                   IF          &LexInt = &objIndex THEN
  43.                   &OpCode     &ObjNames[&objIndex]$&ProcName
  44.                   &objIndex:  SETA 0
  45.                   &found:     SETA 1
  46.                   ELSE
  47.                   &objIndex:  SETA &ObjSupers[&objIndex]
  48.                   ENDIF
  49.                   ENDWHILE
  50. .EndLoop
  51.                   &start:     SETA &LEX(&SYSVALUE, &start)
  52.                   WHILE       (&SYSTOKEN <> 1) AND (&SYSTOKEN <> 30) DO
  53.                   &start:     SETA &LEX(&SYSVALUE, &start)
  54.                   ENDWHILE
  55.                   ENDWHILE
  56.                   ENDIF
  57.  
  58.                   IF          &found = 0 THEN
  59.                   AERROR      &Concat('Error trying to reference method: ',&ProcName)
  60.                   ENDIF
  61.  
  62.                   ENDM
  63.  
  64.                   MACRO
  65.                   SELECTORPROC &ProcName
  66.                   LCLC        &SaveSeg
  67.                   &SaveSeg:   SETC &SYSSEG
  68.                   SEG         '%_SelProcs'
  69.                   &ProcName:  PROC EXPORT
  70.                   JSR         %_METHOD
  71.                   ENDPROC
  72.                   SEG         '&SaveSeg'
  73.                   ENDM
  74.  
  75.  
  76.  
  77.                   MACRO
  78.                   ObjectTemplate &TypeName,&Heritage=NIL,&IntfOnly:INT=0
  79.  
  80.                   GBLA        &ObjSupers[250],&MethLists[250]
  81.                   GBLC        &ObjNames[250]
  82.                   GBLA        &lastObjIndex, &currMethIndex, &MethTable
  83.  
  84.                   GBLA        &NumFields,&NumMethods
  85.                   GBLC        &FieldList[250],&MethodList[250]
  86.  
  87.                   LCLA        &methNum, &fieldNum, &objIndex
  88.                   LCLC        &SaveSeg, &RootIndex
  89.                   LCLA        &SuperIndex, &NumChars, &Temp
  90.                   LCLA        &methIndex, &foundIndex, &MethFlag, &SymReturn
  91.  
  92.                   LCLC        &TempArray[1],&CurrField[2],&CurrMethod[3]
  93.  
  94.                   IF          &MethTable = 0 THEN
  95.                   &MethTable: SETA &NEWSYMTBL
  96.                   ENDIF
  97.  
  98.                   &lastObjIndex: SETA &lastObjIndex+1
  99.                   &ObjNames[&lastObjIndex]: SETC &TypeName
  100.                   &MethLists[&lastObjIndex]: SETA &currMethIndex+1
  101.                   IF          (&Heritage = 'NIL') THEN
  102.                   &ObjSupers[&lastObjIndex]: SETA 0
  103.                   ELSE
  104.                   &SuperIndex: SETA 1
  105.                   &ObjNames[&lastObjIndex+1]: SETC &Heritage
  106.                   WHILE       (&ObjNames[&SuperIndex] <> &Heritage) DO
  107.                   &SuperIndex: SETA &SuperIndex+1
  108.                   ENDWHILE
  109.                   IF          (&SuperIndex > &lastObjIndex) THEN
  110.                   AERROR      &Concat('Non-existent Ancestor Object Type: ',&Heritage)
  111.                   ELSE
  112.                   &ObjSupers[&lastObjIndex]: SETA &SuperIndex
  113.                   ENDIF
  114.                   ENDIF
  115.  
  116.                   IF          &NumFields >= 0 THEN
  117.                   &fieldNum:  SETA 1
  118.                   %&TypeName: RECORD &Heritage.Offset
  119.                   WHILE       &fieldNum <= &NumFields DO
  120.                   &NumChars:  SETA &LEN(&FieldList[&fieldNum])-2
  121.                   &Temp:      SETA &LIST(&FieldList[&fieldNum,2:&NumChars], '&CurrField')
  122.                   IF          &Eval(&CurrField[2]) >= 2 THEN
  123.                   ALIGN       2
  124.                   ENDIF
  125.                   &CurrField[1]: DS.B &CurrField[2]
  126.                   &fieldNum:  SETA &fieldNum+1
  127.                   ENDWHILE
  128.                   ALIGN       2
  129.                   last:       EQU *
  130.                   ENDR
  131.                   &TypeName.Offset: EQU %&TypeName..last
  132.                   ENDIF
  133.  
  134.                   IF          &NumMethods > 0 THEN
  135.                   &methNum:   SETA 1
  136.                   WHILE       &methNum <= &NumMethods DO
  137.                   &NumChars:  SETA &LEN(&MethodList[&methNum])-2
  138.                   &CurrMethod[2]: SETC ''
  139.                   &CurrMethod[3]: SETC ''
  140.                   &Temp:      SETA &LIST(&MethodList[&methNum,2:&NumChars], '&CurrMethod')
  141.                   IF          (&CurrMethod[2] = '') OR (&UC(&CurrMethod[2]) = 'IMPL') THEN
  142.                   IF          (&UC(&CurrMethod[2]) = 'IMPL') THEN
  143.                   IF          &IntfOnly THEN
  144.                   IMPORT      &TypeName.$&CurrMethod[1]
  145.                   ELSE
  146.                   AERROR      &Concat('IMPL only allowed in ObjectIntf Macro. Error at ', \
  147.                   &CurrMethod[1],' in ',&TypeName)
  148.                   ENDIF
  149.                   ELSEIF      &IntfOnly THEN
  150.                   IMPORT      &TypeName.$&CurrMethod[1]
  151.                   ELSE
  152.                   SELECTORPROC &TypeName.$&CurrMethod[1]
  153.                   ENDIF
  154.                   &currMethIndex: SETA &currMethIndex+1
  155.                   &SymReturn: SETA &ENTERSYM(&MethTable,&I2S(&currMethIndex),&CurrMethod[1],0)
  156.  
  157. *                 First       do findsym to see if other unrelated root classes
  158.                   IF          &FINDSYM(&MethTable,&CurrMethod[1]) THEN
  159.                   &RootIndex: SETC &Concat(&SYSVALUE,' ',&I2S(&lastObjIndex))
  160.                   &MethFlag:  SETA &SYSFLAGS+1
  161.                   ELSE
  162.                   &RootIndex: SETC &I2S(&lastObjIndex)
  163.                   &MethFlag:  SETA 1
  164.                   ENDIF
  165.                   &SymReturn: SETA &ENTERSYM(&MethTable,&CurrMethod[1],&RootIndex,&MethFlag)
  166.                   ELSEIF      (&UC(&CurrMethod[2]) <> 'OVERRIDE') THEN
  167.                   AERROR      &Concat(&CurrMethod[2],' illegal after ',&CurrMethod[1], \
  168.                   '           in ',&TypeName)
  169.                   ENDIF
  170.                   IF          NOT &IntfOnly THEN
  171.                   EXPORT      &TypeName._&CurrMethod[1]
  172.                   ELSEIF      (&UC(&CurrMethod[2]) = 'IMPL') OR (&UC(&CurrMethod[3]) = 'IMPL') THEN
  173.                   EXPORT      &TypeName._&CurrMethod[1]
  174.                   ELSE
  175.                   IMPORT      &TypeName._&CurrMethod[1]
  176.                   ENDIF
  177.                   &methNum:   SETA &methNum+1
  178.                   ENDWHILE
  179.  
  180.                   IF          NOT &IntfOnly THEN
  181.                   &SaveSeg:   SETC &SYSSEG
  182.                   SEG         '%_MethTables'
  183.                   CODEREFS    FORCEJT
  184.                   _&TypeName: PROC EXPORT
  185.                   DC.W        _&TypeName
  186.                   IF          &Heritage = 'NIL' THEN
  187.                   DC.W        0
  188.                   ELSE
  189.                   DC.W        _&Heritage
  190.                   ENDIF
  191.                   DC.W        &TypeName.Offset
  192.                   DC.W        &methNum-1
  193.                   &methNum:   SETA 1
  194.                   WHILE       &methNum <= &NumMethods DO
  195.                   &NumChars:  SETA &LEN(&MethodList[&methNum])-2
  196.                   &CurrMethod[2]: SETC ''
  197.                   &CurrMethod[3]: SETC ''
  198.                   &Temp:      SETA &LIST(&MethodList[&methNum,2:&NumChars], '&CurrMethod')
  199.                   IF          (&CurrMethod[2] = '') THEN
  200.                   DC.W        &TypeName.$&CurrMethod[1]
  201.                   ELSEIF      (&UC(&CurrMethod[2]) = 'OVERRIDE') THEN
  202.                   IF          &superIndex = 0 THEN
  203.                   AERROR      &Concat('Override of Non-existent method: ',&CurrMethod[1])
  204.                   ELSE
  205.                   REFSELECTOR &CurrMethod[1],&superIndex,DC.W
  206.                   ENDIF
  207.                   ENDIF
  208.                   IMPORT      &TypeName._&CurrMethod[1]
  209.                   DC.W        &TypeName._&CurrMethod[1]
  210.                   &methNum:   SETA &methNum+1
  211.                   ENDWHILE
  212.                   ENDPROC
  213.                   SEG         '&SaveSeg'
  214.                   CODEREFS    NOFORCEJT
  215.                   ELSE
  216.                   IMPORT      _&TypeName
  217.                   ENDIF
  218.                   ENDIF
  219.                   &MethLists[&lastObjIndex+1]: SETA &currMethIndex+1
  220.                   ENDM
  221.  
  222.  
  223.                   MACRO
  224.                   ObjectDef   &TypeName,&Heritage=NIL
  225.  
  226.                   GBLA        &NumFields,&NumMethods
  227.                   GBLC        &FieldList[250],&MethodList[250]
  228.  
  229.                   LCLA        &index1, &index2
  230.  
  231.                   &index1:    SETA 3
  232.                   &index2:    SETA 1
  233.                   WHILE       &NBR(&SYSLIST[&index1]) <> 0 DO
  234.                   &FieldList[&index2]: SETC &SYSLIST[&index1]
  235.                   &index1:    SETA &index1+1
  236.                   &index2:    SETA &index2+1
  237.                   ENDWHILE
  238.                   &NumFields: SETA &index2-1
  239.  
  240.                   &index2:    SETA 1
  241.                   IF          &SYSLIST[&index1] = 'METHODS' THEN
  242.                   &index1:    SETA &index1+1
  243.                   WHILE       &NBR(&SYSLIST[&index1]) <> 0 DO
  244.                   &MethodList[&index2]: SETC &SYSLIST[&index1]
  245.                   &index1:    SETA &index1+1
  246.                   &index2:    SETA &index2+1
  247.                   ENDWHILE
  248.                   ENDIF
  249.                   &NumMethods: SETA &index2-1
  250.  
  251.                   ObjectTemplate &TypeName,&Heritage,0
  252.                   ENDM
  253.  
  254.  
  255.                   MACRO
  256.                   ObjectIntf  &TypeName,&Heritage=NIL
  257.  
  258.                   GBLA        &NumFields,&NumMethods
  259.                   GBLC        &FieldList[250],&MethodList[250]
  260.  
  261.                   LCLA        &index1, &index2
  262.  
  263.                   &index1:    SETA 3
  264.                   &index2:    SETA 1
  265.                   WHILE       &NBR(&SYSLIST[&index1]) <> 0 DO
  266.                   &FieldList[&index2]: SETC &SYSLIST[&index1]
  267.                   &index1:    SETA &index1+1
  268.                   &index2:    SETA &index2+1
  269.                   ENDWHILE
  270.                   &NumFields: SETA &index2-1
  271.  
  272.                   &index2:    SETA 1
  273.                   IF          &SYSLIST[&index1] = 'METHODS' THEN
  274.                   &index1:    SETA &index1+1
  275.                   WHILE       &NBR(&SYSLIST[&index1]) <> 0 DO
  276.                   &MethodList[&index2]: SETC &SYSLIST[&index1]
  277.                   &index1:    SETA &index1+1
  278.                   &index2:    SETA &index2+1
  279.                   ENDWHILE
  280.                   ENDIF
  281.                   &NumMethods: SETA &index2-1
  282.  
  283.                   ObjectTemplate &TypeName,&Heritage,1
  284.                   ENDM
  285.  
  286.  
  287.  
  288.                   MACRO
  289.                   OBJECTWITH  &TypeName
  290.                   GBLA        &WithLevel[8]
  291.                   GBLA        &WithIndex
  292.                   GBLA        &ObjSupers[*]
  293.                   GBLC        &ObjNames[*]
  294.                   GBLA        &lastObjIndex
  295.  
  296.                   GBLC        &currObjName,&currSuperName
  297.                   GBLA        &currObjIndex
  298.  
  299.                   LCLA        &SuperIndex
  300.                   &currObjName: SETC &TypeName
  301.                   &SuperIndex: SETA 1
  302.                   &ObjNames[&lastObjIndex+1]: SETC &TypeName
  303.                   WHILE       &ObjNames[&SuperIndex] <> &TypeName DO
  304.                   &SuperIndex: SETA &SuperIndex+1
  305.                   ENDWHILE
  306.                   &currObjIndex: SETA &SuperIndex
  307.                   IF          &SuperIndex > &lastObjIndex THEN
  308.                   AERROR      &Concat('Object Type name does not exist: ',&TypeName)
  309.                   ELSE
  310.                   IF          &ObjSupers[&SuperIndex] = 0 THEN
  311.                   &currSuperName: SETC 'NIL'
  312.                   ELSE
  313.                   &currSuperName: SETC &ObjNames[&ObjSupers[&SuperIndex]]
  314.                   ENDIF
  315.                   WITH        %&TypeName
  316.                   &WithIndex: SETA &WithIndex+1
  317.                   WHILE       &ObjSupers[&SuperIndex] <> 0 DO
  318.                   WITH        %&ObjNames[&ObjSupers[&SuperIndex]]
  319.                   &WithLevel[&WithIndex]: SETA &WithLevel[&WithIndex]+1
  320.                   &SuperIndex: SETA &ObjSupers[&SuperIndex]
  321.                   ENDWHILE
  322.                   ENDIF
  323.                   ENDM
  324.  
  325.                   MACRO
  326.                   METHOD      &MethName,&TypeName,&FuncORProc=PROC
  327.                   &TypeName._&MethName: &FuncORProc EXPORT
  328.                   OBJECTWITH  &TypeName
  329.                   ENDM
  330.  
  331.                   MACRO
  332.                   &MethName:  ProcMethOf &TypeName
  333.                   METHOD      &MethName,&TypeName,PROC
  334.                   ENDM
  335.  
  336.                   MACRO
  337.                   &MethName:  FuncMethOf &TypeName
  338.                   METHOD      &MethName,&TypeName,FUNC
  339.                   ENDM
  340.  
  341.                   MACRO
  342.                   ObjectEndWith
  343.                   ENDWITH
  344.                   GBLA        &WithLevel[*]
  345.                   GBLA        &WithIndex
  346.                   IF          &WithIndex > 0 THEN
  347.                   WHILE       &WithLevel[&WithIndex] > 0 DO
  348.                   ENDWITH
  349.                   &WithLevel[&WithIndex]: SETA &WithLevel[&WithIndex]-1
  350.                   ENDWHILE
  351.                   &WithIndex: SETA &WithIndex-1
  352.                   ENDIF
  353.                   ENDM
  354.  
  355.  
  356.                   MACRO
  357.                   ENDMETHOD
  358.                   ObjectEndWith
  359.                   ENDPROC
  360.                   ENDM
  361.  
  362.  
  363.                   MACRO
  364.                   METHCALL    &MethName,&ObjTypeName
  365.                   GBLC        &ObjNames[*]
  366.                   GBLA        &currObjIndex, &lastObjIndex
  367.  
  368.                   LCLA        &objIndex
  369.                   IF          &ObjTypeName = '' THEN
  370.                   &objIndex:  SETA &currObjIndex
  371.                   ELSE
  372.                   &objIndex:  SETA 1
  373.                   &ObjNames[&lastObjIndex+1]: SETC &ObjTypeName
  374.                   WHILE       &ObjNames[&objIndex] <> &ObjTypeName DO
  375.                   &objIndex:  SETA &objIndex+1
  376.                   ENDWHILE
  377.                   ENDIF
  378.                   IF          &objIndex > &lastObjIndex THEN
  379.                   AERROR      &Concat('Unknown Object type Name: ',&ObjTypeName)
  380.                   ELSEIF      ObjOptFlag THEN
  381.                   JSR         &ObjNames[&objIndex]$&MethName
  382.                   ELSE
  383.                   REFSELECTOR &MethName,&objIndex,JSR
  384.                   ENDIF
  385.                   ENDM
  386.  
  387.                   MACRO
  388.                   INHERITED   &MethName
  389.                   GBLC        &ObjNames[*]
  390.                   GBLA        &ObjSupers[*]
  391.                   GBLA        &currObjIndex
  392.  
  393.                   LCLA        &objIndex
  394.  
  395.                   &objIndex:  SETA &ObjSupers[&currObjIndex]
  396.                   WHILE       (&TYPE(&Concat(&ObjNames[&objIndex],'_',&MethName)) = 'UNDEFINED') AND (&objIndex <> 0) DO
  397.                   &objIndex:  SETA &ObjSupers[&objIndex]
  398.                   ENDWHILE
  399.                   IF          &objIndex = 0 THEN
  400.                 AERROR &Concat('Inherited error; Method not defined in ancestor: ',&MethName)
  401.                   ELSE
  402.                   IMPORT      &ObjNames[&objIndex]_&MethName
  403.                   JSR         &ObjNames[&objIndex]_&MethName
  404.                   ENDIF
  405.                   ENDM
  406.  
  407.  
  408.                   MACRO
  409.                   MoveSelf    &Dest
  410.                   MOVE.L      8(A6),&Dest
  411.                   ENDM
  412.  
  413.  
  414.                   MACRO
  415.                   NewObject   &Loc,&TypeName,&Size
  416.                   PEA         &Loc
  417.                   PEA         _&TypeName+2
  418.                   IF          &Size = '' THEN
  419.                   MOVE.W      #&TypeName.Offset,-(SP)
  420.                   ELSE
  421.                   MOVE.W      #&Size,-(SP)
  422.                   ENDIF
  423.                   JSR         %_OBNEW
  424.                   ENDM
  425. *                 The         InitObjects macro must be called if the main program is not in Pascal
  426.  
  427.                   IMPORT      %_PGM1
  428.  
  429.                   MACRO
  430.                   InitObjects
  431.  
  432.                   JSR         %_PGM1
  433.                   ENDM
  434.  
  435.  
  436. NILOffset         EQU         2
  437.  
  438.                   IF          DebugFlag THEN
  439.  
  440.                   ObjectIntf  TObject,, \ Suggested root class for all objects
  441.                   METHODS,    \ no data fields
  442.                 (ShallowClone), \ Object copying method; rarely overridden
  443.                 (Clone), \ Can be overriden to clone fields
  444.                 (ShallowFree), \ Frees object; rarely overridden
  445.                   (Free),     \ Can be overriden to free fields
  446.                   (ClassName), \ Returns name of class
  447.                   (Inspect)                             ; Print info to debug window
  448.                   ELSE
  449.                   ObjectIntf  TObject,, \ Suggested root class for all objects
  450.                   METHODS,    \ no data fields
  451.                 (ShallowClone), \ Object copying method; rarely overridden
  452.                 (Clone), \ Can be overriden to clone fields
  453.                 (ShallowFree), \ Frees object; rarely overridden
  454.                 (Free) ; Can be overriden to free fields
  455.                 
  456.                 ENDIF
  457.  
  458.     ELSE
  459.         aerror    'ObjMacros.a is a 68K only assembly file!'
  460.     ENDIF    ; ...GENERATING68K
  461.         
  462.     ENDIF    ; ...already included